home *** CD-ROM | disk | FTP | other *** search
/ IRIX Base Documentation 1998 November / IRIX 6.5.2 Base Documentation November 1998.img / usr / share / catman / u_man / cat1 / perltie.z / perltie
Text File  |  1998-10-30  |  39KB  |  1,123 lines
  1.  
  2.  
  3.  
  4. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  5.  
  6.  
  7.  
  8. NNNNAAAAMMMMEEEE
  9.      perltie - how to hide an object class in a simple variable
  10.  
  11. SSSSYYYYNNNNOOOOPPPPSSSSIIIISSSS
  12.       tie VARIABLE, CLASSNAME, LIST
  13.  
  14.       $object = tied VARIABLE
  15.  
  16.       untie VARIABLE
  17.  
  18.  
  19. DDDDEEEESSSSCCCCRRRRIIIIPPPPTTTTIIIIOOOONNNN
  20.      Prior to release 5.0 of Perl, a programmer could use _d_b_m_o_p_e_n() to connect
  21.      an on-disk database in the standard Unix _d_b_m(3x) format magically to a
  22.      %HASH in their program.  However, their Perl was either built with one
  23.      particular dbm library or another, but not both, and you couldn't extend
  24.      this mechanism to other packages or types of variables.
  25.  
  26.      Now you can.
  27.  
  28.      The _t_i_e() function binds a variable to a class (package) that will
  29.      provide the implementation for access methods for that variable.  Once
  30.      this magic has been performed, accessing a tied variable automatically
  31.      triggers method calls in the proper class.  All of the complexity of the
  32.      class is hidden behind magic methods calls.  The method names are in ALL
  33.      CAPS, which is a convention that Perl uses to indicate that they're
  34.      called implicitly rather than explicitly--just like the _B_E_G_I_N() and _E_N_D()
  35.      functions.
  36.  
  37.      In the _t_i_e() call, VARIABLE is the name of the variable to be enchanted.
  38.      CLASSNAME is the name of a class implementing objects of the correct
  39.      type.  Any additional arguments in the LIST are passed to the appropriate
  40.      constructor method for that class--meaning _T_I_E_S_C_A_L_A_R(), _T_I_E_A_R_R_A_Y(),
  41.      _T_I_E_H_A_S_H(), or _T_I_E_H_A_N_D_L_E().  (Typically these are arguments such as might
  42.      be passed to the _d_b_m_i_n_i_t() function of C.) The object returned by the
  43.      "new" method is also returned by the _t_i_e() function, which would be
  44.      useful if you wanted to access other methods in CLASSNAME. (You don't
  45.      actually have to return a reference to a right "type" (e.g., HASH or
  46.      CLASSNAME) so long as it's a properly blessed object.)  You can also
  47.      retrieve a reference to the underlying object using the _t_i_e_d() function.
  48.  
  49.      Unlike _d_b_m_o_p_e_n(), the _t_i_e() function will not use or require a module for
  50.      you--you need to do that explicitly yourself.
  51.  
  52.      TTTTyyyyiiiinnnngggg SSSSccccaaaallllaaaarrrrssss
  53.  
  54.      A class implementing a tied scalar should define the following methods:
  55.      TIESCALAR, FETCH, STORE, and possibly DESTROY.
  56.  
  57.      Let's look at each in turn, using as an example a tie class for scalars
  58.      that allows the user to do something like:
  59.  
  60.  
  61.  
  62.  
  63.                                                                         PPPPaaaaggggeeee 1111
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  71.  
  72.  
  73.  
  74.          tie $his_speed, 'Nice', getppid();
  75.          tie $my_speed,  'Nice', $$;
  76.  
  77.      And now whenever either of those variables is accessed, its current
  78.      system priority is retrieved and returned.  If those variables are set,
  79.      then the process's priority is changed!
  80.  
  81.      We'll use Jarkko Hietaniemi <_j_h_i@_i_k_i._f_i>'s BSD::Resource class (not
  82.      included) to access the PRIO_PROCESS, PRIO_MIN, and PRIO_MAX constants
  83.      from your system, as well as the _g_e_t_p_r_i_o_r_i_t_y() and _s_e_t_p_r_i_o_r_i_t_y() system
  84.      calls.  Here's the preamble of the class.
  85.  
  86.          package Nice;
  87.          use Carp;
  88.          use BSD::Resource;
  89.          use strict;
  90.          $Nice::DEBUG = 0 unless defined $Nice::DEBUG;
  91.  
  92.  
  93.      TIESCALAR classname, LIST
  94.           This is the constructor for the class.  That means it is expected to
  95.           return a blessed reference to a new scalar (probably anonymous) that
  96.           it's creating.  For example:
  97.  
  98.               sub TIESCALAR {
  99.                   my $class = shift;
  100.                   my $pid = shift || $$; # 0 means me
  101.  
  102.                   if ($pid !~ /^\d+$/) {
  103.                       carp "Nice::Tie::Scalar got non-numeric pid $pid" if $^W;
  104.                       return undef;
  105.                   }
  106.  
  107.                   unless (kill 0, $pid) { # EPERM or ERSCH, no doubt
  108.                       carp "Nice::Tie::Scalar got bad pid $pid: $!" if $^W;
  109.                       return undef;
  110.                   }
  111.  
  112.                   return bless \$pid, $class;
  113.               }
  114.  
  115.           This tie class has chosen to return an error rather than raising an
  116.           exception if its constructor should fail.  While this is how
  117.           _d_b_m_o_p_e_n() works, other classes may well not wish to be so forgiving.
  118.           It checks the global variable $^W to see whether to emit a bit of
  119.           noise anyway.
  120.  
  121.      FETCH this
  122.           This method will be triggered every time the tied variable is
  123.           accessed (read).  It takes no arguments beyond its self reference,
  124.           which is the object representing the scalar we're dealing with.
  125.           Because in this case we're using just a SCALAR ref for the tied
  126.  
  127.  
  128.  
  129.                                                                         PPPPaaaaggggeeee 2222
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  137.  
  138.  
  139.  
  140.           scalar object, a simple $$self allows the method to get at the real
  141.           value stored there.  In our example below, that real value is the
  142.           process ID to which we've tied our variable.
  143.  
  144.               sub FETCH {
  145.                   my $self = shift;
  146.                   confess "wrong type" unless ref $self;
  147.                   croak "usage error" if @_;
  148.                   my $nicety;
  149.                   local($!) = 0;
  150.                   $nicety = getpriority(PRIO_PROCESS, $$self);
  151.                   if ($!) { croak "getpriority failed: $!" }
  152.                   return $nicety;
  153.               }
  154.  
  155.           This time we've decided to blow up (raise an exception) if the
  156.           renice fails--there's no place for us to return an error otherwise,
  157.           and it's probably the right thing to do.
  158.  
  159.      STORE this, value
  160.           This method will be triggered every time the tied variable is set
  161.           (assigned).  Beyond its self reference, it also expects one (and
  162.           only one) argument--the new value the user is trying to assign.
  163.  
  164.               sub STORE {
  165.                   my $self = shift;
  166.                   confess "wrong type" unless ref $self;
  167.                   my $new_nicety = shift;
  168.                   croak "usage error" if @_;
  169.  
  170.                   if ($new_nicety < PRIO_MIN) {
  171.                       carp sprintf
  172.                         "WARNING: priority %d less than minimum system priority %d",
  173.                             $new_nicety, PRIO_MIN if $^W;
  174.                       $new_nicety = PRIO_MIN;
  175.                   }
  176.  
  177.                   if ($new_nicety > PRIO_MAX) {
  178.                       carp sprintf
  179.                         "WARNING: priority %d greater than maximum system priority %d",
  180.                             $new_nicety, PRIO_MAX if $^W;
  181.                       $new_nicety = PRIO_MAX;
  182.                   }
  183.  
  184.                   unless (defined setpriority(PRIO_PROCESS, $$self, $new_nicety)) {
  185.                       confess "setpriority failed: $!";
  186.                   }
  187.                   return $new_nicety;
  188.               }
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.                                                                         PPPPaaaaggggeeee 3333
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  203.  
  204.  
  205.  
  206.      DESTROY this
  207.           This method will be triggered when the tied variable needs to be
  208.           destructed.  As with other object classes, such a method is seldom
  209.           necessary, because Perl deallocates its moribund object's memory for
  210.           you automatically--this isn't C++, you know.  We'll use a DESTROY
  211.           method here for debugging purposes only.
  212.  
  213.               sub DESTROY {
  214.                   my $self = shift;
  215.                   confess "wrong type" unless ref $self;
  216.                   carp "[ Nice::DESTROY pid $$self ]" if $Nice::DEBUG;
  217.               }
  218.  
  219.  
  220.      That's about all there is to it.  Actually, it's more than all there is
  221.      to it, because we've done a few nice things here for the sake of
  222.      completeness, robustness, and general aesthetics.  Simpler TIESCALAR
  223.      classes are certainly possible.
  224.  
  225.      TTTTyyyyiiiinnnngggg AAAArrrrrrrraaaayyyyssss
  226.  
  227.      A class implementing a tied ordinary array should define the following
  228.      methods: TIEARRAY, FETCH, STORE, and perhaps DESTROY.
  229.  
  230.      WWWWAAAARRRRNNNNIIIINNNNGGGG: Tied arrays are _i_n_c_o_m_p_l_e_t_e.  They are also distinctly lacking
  231.      something for the $#ARRAY access (which is hard, as it's an lvalue), as
  232.      well as the other obvious array functions, like _p_u_s_h(), _p_o_p(), _s_h_i_f_t(),
  233.      _u_n_s_h_i_f_t(), and _s_p_l_i_c_e().
  234.  
  235.      For this discussion, we'll implement an array whose indices are fixed at
  236.      its creation.  If you try to access anything beyond those bounds, you'll
  237.      take an exception.  (Well, if you access an individual element; an
  238.      aggregate assignment would be missed.) For example:
  239.  
  240.          require Bounded_Array;
  241.          tie @ary, 'Bounded_Array', 2;
  242.          $| = 1;
  243.          for $i (0 .. 10) {
  244.              print "setting index $i: ";
  245.              $ary[$i] = 10 * $i;
  246.              $ary[$i] = 10 * $i;
  247.              print "value of elt $i now $ary[$i]\n";
  248.          }
  249.  
  250.      The preamble code for the class is as follows:
  251.  
  252.          package Bounded_Array;
  253.          use Carp;
  254.          use strict;
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.                                                                         PPPPaaaaggggeeee 4444
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  269.  
  270.  
  271.  
  272.      TIEARRAY classname, LIST
  273.           This is the constructor for the class.  That means it is expected to
  274.           return a blessed reference through which the new array (probably an
  275.           anonymous ARRAY ref) will be accessed.
  276.  
  277.           In our example, just to show you that you don't _r_e_a_l_l_y have to
  278.           return an ARRAY reference, we'll choose a HASH reference to
  279.           represent our object.  A HASH works out well as a generic record
  280.           type: the {BOUND} field will store the maximum bound allowed, and
  281.           the {ARRAY} field will hold the true ARRAY ref.  If someone outside
  282.           the class tries to dereference the object returned (doubtless
  283.           thinking it an ARRAY ref), they'll blow up.  This just goes to show
  284.           you that you should respect an object's privacy.
  285.  
  286.               sub TIEARRAY {
  287.                   my $class = shift;
  288.                   my $bound = shift;
  289.                   confess "usage: tie(\@ary, 'Bounded_Array', max_subscript)"
  290.                       if @_ || $bound =~ /\D/;
  291.                   return bless {
  292.                       BOUND => $bound,
  293.                       ARRAY => [],
  294.                   }, $class;
  295.               }
  296.  
  297.  
  298.      FETCH this, index
  299.           This method will be triggered every time an individual element the
  300.           tied array is accessed (read).  It takes one argument beyond its
  301.           self reference: the index whose value we're trying to fetch.
  302.  
  303.               sub FETCH {
  304.                 my($self,$idx) = @_;
  305.                 if ($idx > $self->{BOUND}) {
  306.                   confess "Array OOB: $idx > $self->{BOUND}";
  307.                 }
  308.                 return $self->{ARRAY}[$idx];
  309.               }
  310.  
  311.           As you may have noticed, the name of the FETCH method (et al.) is
  312.           the same for all accesses, even though the constructors differ in
  313.           names (TIESCALAR vs TIEARRAY).  While in theory you could have the
  314.           same class servicing several tied types, in practice this becomes
  315.           cumbersome, and it's easiest to keep them at simply one tie type per
  316.           class.
  317.  
  318.      STORE this, index, value
  319.           This method will be triggered every time an element in the tied
  320.           array is set (written).  It takes two arguments beyond its self
  321.           reference: the index at which we're trying to store something and
  322.           the value we're trying to put there.  For example:
  323.  
  324.  
  325.  
  326.  
  327.                                                                         PPPPaaaaggggeeee 5555
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  335.  
  336.  
  337.  
  338.               sub STORE {
  339.                 my($self, $idx, $value) = @_;
  340.                 print "[STORE $value at $idx]\n" if _debug;
  341.                 if ($idx > $self->{BOUND} ) {
  342.                   confess "Array OOB: $idx > $self->{BOUND}";
  343.                 }
  344.                 return $self->{ARRAY}[$idx] = $value;
  345.               }
  346.  
  347.  
  348.      DESTROY this
  349.           This method will be triggered when the tied variable needs to be
  350.           destructed.  As with the scalar tie class, this is almost never
  351.           needed in a language that does its own garbage collection, so this
  352.           time we'll just leave it out.
  353.  
  354.      The code we presented at the top of the tied array class accesses many
  355.      elements of the array, far more than we've set the bounds to.  Therefore,
  356.      it will blow up once they try to access beyond the 2nd element of @ary,
  357.      as the following output demonstrates:
  358.  
  359.          setting index 0: value of elt 0 now 0
  360.          setting index 1: value of elt 1 now 10
  361.          setting index 2: value of elt 2 now 20
  362.          setting index 3: Array OOB: 3 > 2 at Bounded_Array.pm line 39
  363.                  Bounded_Array::FETCH called at testba line 12
  364.  
  365.  
  366.      TTTTyyyyiiiinnnngggg HHHHaaaasssshhhheeeessss
  367.  
  368.      As the first Perl data type to be tied (see _d_b_m_o_p_e_n()), hashes have the
  369.      most complete and useful _t_i_e() implementation.  A class implementing a
  370.      tied hash should define the following methods: TIEHASH is the
  371.      constructor.  FETCH and STORE access the key and value pairs.  EXISTS
  372.      reports whether a key is present in the hash, and DELETE deletes one.
  373.      CLEAR empties the hash by deleting all the key and value pairs.  FIRSTKEY
  374.      and NEXTKEY implement the _k_e_y_s() and _e_a_c_h() functions to iterate over all
  375.      the keys.  And DESTROY is called when the tied variable is garbage
  376.      collected.
  377.  
  378.      If this seems like a lot, then feel free to inherit from merely the
  379.      standard Tie::Hash module for most of your methods, redefining only the
  380.      interesting ones.  See the _T_i_e::_H_a_s_h manpage for details.
  381.  
  382.      Remember that Perl distinguishes between a key not existing in the hash,
  383.      and the key existing in the hash but having a corresponding value of
  384.      undef.  The two possibilities can be tested with the exists() and
  385.      defined() functions.
  386.  
  387.      Here's an example of a somewhat interesting tied hash class:  it gives
  388.      you a hash representing a particular user's dot files.  You index into
  389.      the hash with the name of the file (minus the dot) and you get back that
  390.  
  391.  
  392.  
  393.                                                                         PPPPaaaaggggeeee 6666
  394.  
  395.  
  396.  
  397.  
  398.  
  399.  
  400. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  401.  
  402.  
  403.  
  404.      dot file's contents.  For example:
  405.  
  406.          use DotFiles;
  407.          tie %dot, 'DotFiles';
  408.          if ( $dot{profile} =~ /MANPATH/ ||
  409.               $dot{login}   =~ /MANPATH/ ||
  410.               $dot{cshrc}   =~ /MANPATH/    )
  411.          {
  412.              print "you seem to set your MANPATH\n";
  413.          }
  414.  
  415.      Or here's another sample of using our tied class:
  416.  
  417.          tie %him, 'DotFiles', 'daemon';
  418.          foreach $f ( keys %him ) {
  419.              printf "daemon dot file %s is size %d\n",
  420.                  $f, length $him{$f};
  421.          }
  422.  
  423.      In our tied hash DotFiles example, we use a regular hash for the object
  424.      containing several important fields, of which only the {LIST} field will
  425.      be what the user thinks of as the real hash.
  426.  
  427.      USER whose dot files this object represents
  428.  
  429.      HOME where those dot files live
  430.  
  431.      CLOBBER
  432.           whether we should try to change or remove those dot files
  433.  
  434.      LIST the hash of dot file names and content mappings
  435.  
  436.      Here's the start of _D_o_t_f_i_l_e_s._p_m:
  437.  
  438.          package DotFiles;
  439.          use Carp;
  440.          sub whowasi { (caller(1))[3] . '()' }
  441.          my $DEBUG = 0;
  442.          sub debug { $DEBUG = @_ ? shift : 1 }
  443.  
  444.      For our example, we want to be able to emit debugging info to help in
  445.      tracing during development.  We keep also one convenience function around
  446.      internally to help print out warnings; _w_h_o_w_a_s_i() returns the function
  447.      name that calls it.
  448.  
  449.      Here are the methods for the DotFiles tied hash.
  450.  
  451.      TIEHASH classname, LIST
  452.           This is the constructor for the class.  That means it is expected to
  453.           return a blessed reference through which the new object (probably
  454.           but not necessarily an anonymous hash) will be accessed.
  455.  
  456.  
  457.  
  458.  
  459.                                                                         PPPPaaaaggggeeee 7777
  460.  
  461.  
  462.  
  463.  
  464.  
  465.  
  466. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  467.  
  468.  
  469.  
  470.           Here's the constructor:
  471.  
  472.               sub TIEHASH {
  473.                   my $self = shift;
  474.                   my $user = shift || $>;
  475.                   my $dotdir = shift || '';
  476.                   croak "usage: @{[&whowasi]} [USER [DOTDIR]]" if @_;
  477.                   $user = getpwuid($user) if $user =~ /^\d+$/;
  478.                   my $dir = (getpwnam($user))[7]
  479.                           || croak "@{[&whowasi]}: no user $user";
  480.                   $dir .= "/$dotdir" if $dotdir;
  481.  
  482.                   my $node = {
  483.                       USER    => $user,
  484.                       HOME    => $dir,
  485.                       LIST    => {},
  486.                       CLOBBER => 0,
  487.                   };
  488.  
  489.                   opendir(DIR, $dir)
  490.                           || croak "@{[&whowasi]}: can't opendir $dir: $!";
  491.                   foreach $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) {
  492.                       $dot =~ s/^\.//;
  493.                       $node->{LIST}{$dot} = undef;
  494.                   }
  495.                   closedir DIR;
  496.                   return bless $node, $self;
  497.               }
  498.  
  499.           It's probably worth mentioning that if you're going to filetest the
  500.           return values out of a readdir, you'd better prepend the directory
  501.           in question.  Otherwise, because we didn't _c_h_d_i_r() there, it would
  502.           have been testing the wrong file.
  503.  
  504.      FETCH this, key
  505.           This method will be triggered every time an element in the tied hash
  506.           is accessed (read).  It takes one argument beyond its self
  507.           reference: the key whose value we're trying to fetch.
  508.  
  509.           Here's the fetch for our DotFiles example.
  510.  
  511.               sub FETCH {
  512.                   carp &whowasi if $DEBUG;
  513.                   my $self = shift;
  514.                   my $dot = shift;
  515.                   my $dir = $self->{HOME};
  516.                   my $file = "$dir/.$dot";
  517.  
  518.                   unless (exists $self->{LIST}->{$dot} || -f $file) {
  519.                       carp "@{[&whowasi]}: no $dot file" if $DEBUG;
  520.                       return undef;
  521.                   }
  522.  
  523.  
  524.  
  525.                                                                         PPPPaaaaggggeeee 8888
  526.  
  527.  
  528.  
  529.  
  530.  
  531.  
  532. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  533.  
  534.  
  535.  
  536.                   if (defined $self->{LIST}->{$dot}) {
  537.                       return $self->{LIST}->{$dot};
  538.                   } else {
  539.                       return $self->{LIST}->{$dot} = `cat $dir/.$dot`;
  540.                   }
  541.               }
  542.  
  543.           It was easy to write by having it call the Unix _c_a_t(1) command, but
  544.           it would probably be more portable to open the file manually (and
  545.           somewhat more efficient).  Of course, because dot files are a Unixy
  546.           concept, we're not that concerned.
  547.  
  548.      STORE this, key, value
  549.           This method will be triggered every time an element in the tied hash
  550.           is set (written).  It takes two arguments beyond its self reference:
  551.           the index at which we're trying to store something, and the value
  552.           we're trying to put there.
  553.  
  554.           Here in our DotFiles example, we'll be careful not to let them try
  555.           to overwrite the file unless they've called the _c_l_o_b_b_e_r() method on
  556.           the original object reference returned by _t_i_e().
  557.  
  558.               sub STORE {
  559.                   carp &whowasi if $DEBUG;
  560.                   my $self = shift;
  561.                   my $dot = shift;
  562.                   my $value = shift;
  563.                   my $file = $self->{HOME} . "/.$dot";
  564.                   my $user = $self->{USER};
  565.  
  566.                   croak "@{[&whowasi]}: $file not clobberable"
  567.                       unless $self->{CLOBBER};
  568.  
  569.                   open(F, "> $file") || croak "can't open $file: $!";
  570.                   print F $value;
  571.                   close(F);
  572.               }
  573.  
  574.           If they wanted to clobber something, they might say:
  575.  
  576.               $ob = tie %daemon_dots, 'daemon';
  577.               $ob->clobber(1);
  578.               $daemon_dots{signature} = "A true daemon\n";
  579.  
  580.           Another way to lay hands on a reference to the underlying object is
  581.           to use the _t_i_e_d() function, so they might alternately have set
  582.           clobber using:
  583.  
  584.               tie %daemon_dots, 'daemon';
  585.               tied(%daemon_dots)->clobber(1);
  586.  
  587.           The clobber method is simply:
  588.  
  589.  
  590.  
  591.                                                                         PPPPaaaaggggeeee 9999
  592.  
  593.  
  594.  
  595.  
  596.  
  597.  
  598. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  599.  
  600.  
  601.  
  602.               sub clobber {
  603.                   my $self = shift;
  604.                   $self->{CLOBBER} = @_ ? shift : 1;
  605.               }
  606.  
  607.  
  608.      DELETE this, key
  609.           This method is triggered when we remove an element from the hash,
  610.           typically by using the _d_e_l_e_t_e() function.  Again, we'll be careful
  611.           to check whether they really want to clobber files.
  612.  
  613.               sub DELETE   {
  614.                   carp &whowasi if $DEBUG;
  615.  
  616.                   my $self = shift;
  617.                   my $dot = shift;
  618.                   my $file = $self->{HOME} . "/.$dot";
  619.                   croak "@{[&whowasi]}: won't remove file $file"
  620.                       unless $self->{CLOBBER};
  621.                   delete $self->{LIST}->{$dot};
  622.                   my $success = unlink($file);
  623.                   carp "@{[&whowasi]}: can't unlink $file: $!" unless $success;
  624.                   $success;
  625.               }
  626.  
  627.           The value returned by DELETE becomes the return value of the call to
  628.           _d_e_l_e_t_e().  If you want to emulate the normal behavior of _d_e_l_e_t_e(),
  629.           you should return whatever FETCH would have returned for this key.
  630.           In this example, we have chosen instead to return a value which
  631.           tells the caller whether the file was successfully deleted.
  632.  
  633.      CLEAR this
  634.           This method is triggered when the whole hash is to be cleared,
  635.           usually by assigning the empty list to it.
  636.  
  637.           In our example, that would remove all the user's dot files!  It's
  638.           such a dangerous thing that they'll have to set CLOBBER to something
  639.           higher than 1 to make it happen.
  640.  
  641.               sub CLEAR    {
  642.                   carp &whowasi if $DEBUG;
  643.                   my $self = shift;
  644.                   croak "@{[&whowasi]}: won't remove all dot files for $self->{USER}"
  645.                       unless $self->{CLOBBER} > 1;
  646.                   my $dot;
  647.                   foreach $dot ( keys %{$self->{LIST}}) {
  648.                       $self->DELETE($dot);
  649.                   }
  650.               }
  651.  
  652.  
  653.  
  654.  
  655.  
  656.  
  657.                                                                        PPPPaaaaggggeeee 11110000
  658.  
  659.  
  660.  
  661.  
  662.  
  663.  
  664. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  665.  
  666.  
  667.  
  668.      EXISTS this, key
  669.           This method is triggered when the user uses the _e_x_i_s_t_s() function on
  670.           a particular hash.  In our example, we'll look at the {LIST} hash
  671.           element for this:
  672.  
  673.               sub EXISTS   {
  674.                   carp &whowasi if $DEBUG;
  675.                   my $self = shift;
  676.                   my $dot = shift;
  677.                   return exists $self->{LIST}->{$dot};
  678.               }
  679.  
  680.  
  681.      FIRSTKEY this
  682.           This method will be triggered when the user is going to iterate
  683.           through the hash, such as via a _k_e_y_s() or _e_a_c_h() call.
  684.  
  685.               sub FIRSTKEY {
  686.                   carp &whowasi if $DEBUG;
  687.                   my $self = shift;
  688.                   my $a = keys %{$self->{LIST}};          # reset each() iterator
  689.                   each %{$self->{LIST}}
  690.               }
  691.  
  692.  
  693.      NEXTKEY this, lastkey
  694.           This method gets triggered during a _k_e_y_s() or _e_a_c_h() iteration.  It
  695.           has a second argument which is the last key that had been accessed.
  696.           This is useful if you're carrying about ordering or calling the
  697.           iterator from more than one sequence, or not really storing things
  698.           in a hash anywhere.
  699.  
  700.           For our example, we're using a real hash so we'll do just the simple
  701.           thing, but we'll have to go through the LIST field indirectly.
  702.  
  703.               sub NEXTKEY  {
  704.                   carp &whowasi if $DEBUG;
  705.                   my $self = shift;
  706.                   return each %{ $self->{LIST} }
  707.               }
  708.  
  709.  
  710.      DESTROY this
  711.           This method is triggered when a tied hash is about to go out of
  712.           scope.  You don't really need it unless you're trying to add
  713.           debugging or have auxiliary state to clean up.  Here's a very simple
  714.           function:
  715.  
  716.               sub DESTROY  {
  717.                   carp &whowasi if $DEBUG;
  718.               }
  719.  
  720.  
  721.  
  722.  
  723.                                                                        PPPPaaaaggggeeee 11111111
  724.  
  725.  
  726.  
  727.  
  728.  
  729.  
  730. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  731.  
  732.  
  733.  
  734.      Note that functions such as _k_e_y_s() and _v_a_l_u_e_s() may return huge array
  735.      values when used on large objects, like DBM files.  You may prefer to use
  736.      the _e_a_c_h() function to iterate over such.  Example:
  737.  
  738.          # print out history file offsets
  739.          use NDBM_File;
  740.          tie(%HIST, 'NDBM_File', '/usr/lib/news/history', 1, 0);
  741.          while (($key,$val) = each %HIST) {
  742.              print $key, ' = ', unpack('L',$val), "\n";
  743.          }
  744.          untie(%HIST);
  745.  
  746.  
  747.      TTTTyyyyiiiinnnngggg FFFFiiiilllleeeeHHHHaaaannnnddddlllleeeessss
  748.  
  749.      This is partially implemented now.
  750.  
  751.      A class implementing a tied filehandle should define the following
  752.      methods: TIEHANDLE, at least one of PRINT, PRINTF, READLINE, GETC, or
  753.      READ, and possibly DESTROY.
  754.  
  755.      It is especially useful when perl is embedded in some other program,
  756.      where output to STDOUT and STDERR may have to be redirected in some
  757.      special way. See nvi and the Apache module for examples.
  758.  
  759.      In our example we're going to create a shouting handle.
  760.  
  761.          package Shout;
  762.  
  763.  
  764.      TIEHANDLE classname, LIST
  765.           This is the constructor for the class.  That means it is expected to
  766.           return a blessed reference of some sort. The reference can be used
  767.           to hold some internal information.
  768.  
  769.               sub TIEHANDLE { print "<shout>\n"; my $i; bless \$i, shift }
  770.  
  771.  
  772.      PRINT this, LIST
  773.           This method will be triggered every time the tied handle is printed
  774.           to with the print() function.  Beyond its self reference it also
  775.           expects the list that was passed to the print function.
  776.  
  777.               sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ }
  778.  
  779.  
  780.      PRINTF this, LIST
  781.           This method will be triggered every time the tied handle is printed
  782.           to with the printf() function.  Beyond its self reference it also
  783.           expects the format and list that was passed to the printf function.
  784.  
  785.  
  786.  
  787.  
  788.  
  789.                                                                        PPPPaaaaggggeeee 11112222
  790.  
  791.  
  792.  
  793.  
  794.  
  795.  
  796. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  797.  
  798.  
  799.  
  800.               sub PRINTF {
  801.                   shift;
  802.                   my $fmt = shift;
  803.                   print sprintf($fmt, @_)."\n";
  804.               }
  805.  
  806.  
  807.      READ this LIST
  808.           This method will be called when the handle is read from via the read
  809.           or sysread functions.
  810.  
  811.               sub READ {
  812.                   $r = shift;
  813.                   my($buf,$len,$offset) = @_;
  814.                   print "READ called, \$buf=$buf, \$len=$len, \$offset=$offset";
  815.               }
  816.  
  817.  
  818.      READLINE this
  819.           This method will be called when the handle is read from via
  820.           <HANDLE>.  The method should return undef when there is no more
  821.           data.
  822.  
  823.               sub READLINE { $r = shift; "PRINT called $$r times\n"; }
  824.  
  825.  
  826.      GETC this
  827.           This method will be called when the getc function is called.
  828.  
  829.               sub GETC { print "Don't GETC, Get Perl"; return "a"; }
  830.  
  831.  
  832.      DESTROY this
  833.           As with the other types of ties, this method will be called when the
  834.           tied handle is about to be destroyed. This is useful for debugging
  835.           and possibly cleaning up.
  836.  
  837.               sub DESTROY { print "</shout>\n" }
  838.  
  839.  
  840.      Here's how to use our little example:
  841.  
  842.          tie(*FOO,'Shout');
  843.          print FOO "hello\n";
  844.          $a = 4; $b = 6;
  845.          print FOO $a, " plus ", $b, " equals ", $a + $b, "\n";
  846.          print <FOO>;
  847.  
  848.  
  849.  
  850.  
  851.  
  852.  
  853.  
  854.  
  855.                                                                        PPPPaaaaggggeeee 11113333
  856.  
  857.  
  858.  
  859.  
  860.  
  861.  
  862. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  863.  
  864.  
  865.  
  866.      TTTThhhheeee uuuunnnnttttiiiieeee Gotcha
  867.  
  868.      If you intend making use of the object returned from either _t_i_e() or
  869.      _t_i_e_d(), and if the tie's target class defines a destructor, there is a
  870.      subtle gotcha you _m_u_s_t guard against.
  871.  
  872.      As setup, consider this (admittedly rather contrived) example of a tie;
  873.      all it does is use a file to keep a log of the values assigned to a
  874.      scalar.
  875.  
  876.          package Remember;
  877.  
  878.          use strict;
  879.          use IO::File;
  880.  
  881.          sub TIESCALAR {
  882.              my $class = shift;
  883.              my $filename = shift;
  884.              my $handle = new IO::File "> $filename"
  885.                               or die "Cannot open $filename: $!\n";
  886.  
  887.              print $handle "The Start\n";
  888.              bless {FH => $handle, Value => 0}, $class;
  889.          }
  890.  
  891.          sub FETCH {
  892.              my $self = shift;
  893.              return $self->{Value};
  894.          }
  895.  
  896.          sub STORE {
  897.              my $self = shift;
  898.              my $value = shift;
  899.              my $handle = $self->{FH};
  900.              print $handle "$value\n";
  901.              $self->{Value} = $value;
  902.          }
  903.  
  904.          sub DESTROY {
  905.              my $self = shift;
  906.              my $handle = $self->{FH};
  907.              print $handle "The End\n";
  908.              close $handle;
  909.          }
  910.  
  911.          1;
  912.  
  913.      Here is an example that makes use of this tie:
  914.  
  915.          use strict;
  916.          use Remember;
  917.  
  918.  
  919.  
  920.  
  921.                                                                        PPPPaaaaggggeeee 11114444
  922.  
  923.  
  924.  
  925.  
  926.  
  927.  
  928. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  929.  
  930.  
  931.  
  932.          my $fred;
  933.          tie $fred, 'Remember', 'myfile.txt';
  934.          $fred = 1;
  935.          $fred = 4;
  936.          $fred = 5;
  937.          untie $fred;
  938.          system "cat myfile.txt";
  939.  
  940.      This is the output when it is executed:
  941.  
  942.          The Start
  943.          1
  944.          4
  945.          5
  946.          The End
  947.  
  948.      So far so good.  Those of you who have been paying attention will have
  949.      spotted that the tied object hasn't been used so far.  So lets add an
  950.      extra method to the Remember class to allow comments to be included in
  951.      the file -- say, something like this:
  952.  
  953.          sub comment {
  954.              my $self = shift;
  955.              my $text = shift;
  956.              my $handle = $self->{FH};
  957.              print $handle $text, "\n";
  958.          }
  959.  
  960.      And here is the previous example modified to use the comment method
  961.      (which requires the tied object):
  962.  
  963.          use strict;
  964.          use Remember;
  965.  
  966.          my ($fred, $x);
  967.          $x = tie $fred, 'Remember', 'myfile.txt';
  968.          $fred = 1;
  969.          $fred = 4;
  970.          comment $x "changing...";
  971.          $fred = 5;
  972.          untie $fred;
  973.          system "cat myfile.txt";
  974.  
  975.      When this code is executed there is no output.  Here's why:
  976.  
  977.      When a variable is tied, it is associated with the object which is the
  978.      return value of the TIESCALAR, TIEARRAY, or TIEHASH function.  This
  979.      object normally has only one reference, namely, the implicit reference
  980.      from the tied variable.  When _u_n_t_i_e() is called, that reference is
  981.      destroyed.  Then, as in the first example above, the object's destructor
  982.      (DESTROY) is called, which is normal for objects that have no more valid
  983.      references; and thus the file is closed.
  984.  
  985.  
  986.  
  987.                                                                        PPPPaaaaggggeeee 11115555
  988.  
  989.  
  990.  
  991.  
  992.  
  993.  
  994. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  995.  
  996.  
  997.  
  998.      In the second example, however, we have stored another reference to the
  999.      tied object in $x.  That means that when _u_n_t_i_e() gets called there will
  1000.      still be a valid reference to the object in existence, so the destructor
  1001.      is not called at that time, and thus the file is not closed.  The reason
  1002.      there is no output is because the file buffers have not been flushed to
  1003.      disk.
  1004.  
  1005.      Now that you know what the problem is, what can you do to avoid it?
  1006.      Well, the good old -w flag will spot any instances where you call _u_n_t_i_e()
  1007.      and there are still valid references to the tied object.  If the second
  1008.      script above is run with the -w flag, Perl prints this warning message:
  1009.  
  1010.          untie attempted while 1 inner references still exist
  1011.  
  1012.      To get the script to work properly and silence the warning make sure
  1013.      there are no valid references to the tied object _b_e_f_o_r_e _u_n_t_i_e() is
  1014.      called:
  1015.  
  1016.          undef $x;
  1017.          untie $fred;
  1018.  
  1019.  
  1020. SSSSEEEEEEEE AAAALLLLSSSSOOOO
  1021.      See the _D_B__F_i_l_e manpage or the _C_o_n_f_i_g manpage for some interesting _t_i_e()
  1022.      implementations.
  1023.  
  1024. BBBBUUUUGGGGSSSS
  1025.      Tied arrays are _i_n_c_o_m_p_l_e_t_e.  They are also distinctly lacking something
  1026.      for the $#ARRAY access (which is hard, as it's an lvalue), as well as the
  1027.      other obvious array functions, like _p_u_s_h(), _p_o_p(), _s_h_i_f_t(), _u_n_s_h_i_f_t(),
  1028.      and _s_p_l_i_c_e().
  1029.  
  1030.      You cannot easily tie a multilevel data structure (such as a hash of
  1031.      hashes) to a dbm file.  The first problem is that all but GDBM and
  1032.      Berkeley DB have size limitations, but beyond that, you also have
  1033.      problems with how references are to be represented on disk.  One
  1034.      experimental module that does attempt to address this need partially is
  1035.      the MLDBM module.  Check your nearest CPAN site as described in the
  1036.      _p_e_r_l_m_o_d_l_i_b manpage for source code to MLDBM.
  1037.  
  1038. AAAAUUUUTTTTHHHHOOOORRRR
  1039.      Tom Christiansen
  1040.  
  1041.      TIEHANDLE by Sven Verdoolaege <_s_k_i_m_o@_d_n_s._u_f_s_i_a._a_c._b_e> and Doug MacEachern
  1042.      <_d_o_u_g_m@_o_s_f._o_r_g>
  1043.  
  1044.  
  1045.  
  1046.  
  1047.  
  1048.  
  1049.  
  1050.  
  1051.  
  1052.  
  1053.                                                                        PPPPaaaaggggeeee 11116666
  1054.  
  1055.  
  1056.  
  1057.  
  1058.  
  1059.  
  1060. PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))                                                          PPPPEEEERRRRLLLLTTTTIIIIEEEE((((1111))))
  1061.  
  1062.  
  1063.  
  1064.  
  1065.  
  1066.  
  1067.  
  1068.  
  1069.  
  1070.  
  1071.  
  1072.  
  1073.  
  1074.  
  1075.  
  1076.  
  1077.  
  1078.  
  1079.  
  1080.  
  1081.  
  1082.  
  1083.  
  1084.  
  1085.  
  1086.  
  1087.  
  1088.  
  1089.  
  1090.  
  1091.  
  1092.  
  1093.  
  1094.  
  1095.  
  1096.  
  1097.  
  1098.  
  1099.  
  1100.  
  1101.  
  1102.  
  1103.  
  1104.  
  1105.  
  1106.  
  1107.  
  1108.  
  1109.  
  1110.  
  1111.  
  1112.  
  1113.  
  1114.  
  1115.  
  1116.                                                                        PPPPaaaaggggeeee 11117777
  1117.  
  1118.  
  1119.  
  1120.  
  1121.  
  1122.  
  1123.